COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00010 ENDMK
C⊗;
ENTRY;
BEGIN "PPCODE"
DEFINE $$PRGID=TRUE, $PPCODE=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;

REQUIRE "[][]" DELIMITERS;
REDEFINE MAKEOP(OPNUM,OPNAM,OPVAL)"[]" = [,"OPNAM"];
PRESET_WITH "not valid" INTOPS;
STRING ARRAY SPCODE[0:#ALINTOPS/2];
BOOLEAN TOTTY;
INTEGER OCHAN;

SIMPLE STRING PROCEDURE SCODE(INTEGER I);
	IF I MOD 2 = 0 AND 0≤I≤#ALINTOPS THEN RETURN(SPCODE[I/2])
		ELSE RETURN(SPCODE[0]);

SIMPLE PROCEDURE EMIT(STRING S);
	IF TOTTY THEN OUTSTR(S) ELSE OUT(OCHAN,S);

RECURSIVE PROCEDURE PPRIN(INTEGER ARRAY RR; INTEGER SNUM,INDEXF; STRING INDENT);
BEGIN
	! program to print out pcode from number form to pcode form;
	INTEGER INDEX;
	PROCEDURE RPRINT;
	BEGIN "print real numbers"
		EMIT("	"&CVF(RFVAL(RR[INDEX+1],RR[INDEX+2])));
		INDEX←INDEX+2;
	END;

	PROCEDURE OPRINT;
	"prints octal"	EMIT("	"&CVOS(RR[INDEX←INDEX+1]));

	PROCEDURE RDPRINT(INTEGER OFFSET(0));
	"prints relative decimal"
		BEGIN INTEGER I;
		! if offset not specified then take wrt to current position ;
		I←RR[INDEX←INDEX+1];
		EMIT("	.");
		IF I≥0 THEN EMIT("+");
		EMIT(CVS(I)&"(D)");
		EMIT("	{="&CVS(INDEX+OFFSET+RR[INDEX])&"(D)}");
		END;

	PROCEDURE DPRINT;
	"prints decimal"
		EMIT("	"&CVS(RR[INDEX←INDEX+1])&"(D)");

	PROCEDURE NLPRINT;
	"prints newline"
		EMIT(CRLF&CVS(INDEX+1)&":	"&INDENT);

	PROCEDURE NPCODE;
	BEGIN	"prints new pcode"
		INTEGER I,J;
		NLPRINT;		! start new line;
		I←RR[INDEX←INDEX+1]/2;
		J←RR[INDEX] MOD 2;
		IF J=0 AND 1≤I≤ARRINFO(SPCODE,2)
			THEN EMIT(SPCODE[I])
			ELSE EMIT(CVS(RR[INDEX])&"(D)");
		IF J=0 THEN
		CASE I OF
		BEGIN
		    [XJUMP/2][XPRINT/2][XJUMPC/2][XFORCHK/2]
		    [XRJMP/2][XRJMPC/2][XRFRCHK/2][XRFOREND/2]
			RDPRINT;
		    [XPRNTC/2]
			BEGIN STRING S;
			S←TAB&DQUOTE&(RR[INDEX←INDEX+1] LSH -8)&DQUOTE;
			EMIT(S);
			END;
		    [XPRNTI/2]
			BEGIN STRING S; INTEGER CHAR,SS;
			DPRINT;
			I←INDEX;
			S←TAB&DQUOTE;
			DO BEGIN SS←RR[I←I+1];
				S←S&(CHAR←SS LAND '377)&(CHAR←SS LSH -8);
			END UNTIL CHAR=0;
			INDEX←INDEX+RR[INDEX];
			S←S&DQUOTE;
			EMIT(S);
			END;
		    [XPUSHSCI/2]
			RPRINT;
		    [XMKVT/2][XMKRT/2]
			BEGIN RPRINT;RPRINT;RPRINT;END;
		    [XMKTR/2]
			BEGIN RPRINT;RPRINT;RPRINT; NLPRINT;
				RPRINT;RPRINT;RPRINT; END;
		    [XARRLD/2]
			BEGIN INTEGER I,J; RPTR(SYMBOL)SYM;
			I←RR[INDEX+1];
			OPRINT;DPRINT;
			ARRYDIM(I,SYM);
			IF SYM THEN
				BEGIN
				CASE RR[INDEX] OF
				BEGIN [#SC] J←1;
					[#VT] [#RT] J←3;
					[#TR] [#FR] J←6;
					[#EV] J←0
				END;
			FOR I←1 STEP 1 UNTIL ARRAYREC:#EL[SYMBOL:OBJECT[SYM]]*J
				DO BEGIN NLPRINT;RPRINT; END;
				END;
			END;
		    [XAFFIX/2]
			BEGIN
			OPRINT;	OPRINT;	OPRINT;
			IF RR[INDEX] LAND '2000 THEN OPRINT;
			END;
		    [XAGTVAL/2][XACHNGE/2][XARTVAL/2]
			BEGIN OPRINT; OPRINT; END;
		    [XRCASE/2]
			BEGIN
			INTEGER NCASES,I,J;
			DPRINT;	NCASES←ABS(RR[J←INDEX])+1;
			FOR I←1 STEP 1 UNTIL NCASES DO
				BEGIN NLPRINT; RDPRINT(1-I); END;
			END;
		    [XGTBLK/2]
			BEGIN
			DPRINT;PPRIN(RR,INDEX+1,INDEX+RR[INDEX],INDENT&"    ");
			INDEX←INDEX+RR[INDEX];
			NLPRINT; EMIT(CVS(RR[INDEX←INDEX+1])&"(D)");
			END;
		    [XGTVAL/2][XCHNGE/2][XWHERE/2][XPUSHINTI/2][XKVAR/2]
		    [XRETURN/2][XPROC/2][XCMVAR/2][XPKVAR/2]
		    [XGATHER/2][XCMDSBL/2][XSTOP/2][XCHCMP/2]
		    [XPUSHOFFSET/2][XPAFFIX/2][XCMENBL/2][XTFRCST/2]
		    [XARRINI/2][XCMSKED/2][XGTCMP/2][XSSBRTN/2][XCOMPLY/2]
			OPRINT;
		    [XRCENTER/2][XRPMOVE/2][XRTADRIVE/2][XRTDDRIVE/2]
			BEGIN RDPRINT; OPRINT; END;
		    [XMVAR/2]
			DO OPRINT UNTIL RR[INDEX]=0;
		    [XCMFIL/2]
			BEGIN OPRINT; OPRINT;
				IF RR[INDEX]=#CMFRC THEN OPRINT;
				OPRINT; OPRINT;
			END;
		    [XAPUSHOFFSET/2]
			BEGIN OPRINT;OPRINT END;
		    [XGTINT/2][XGVALS/2][XCHNGS/2][XPUNFIX/2]
			INDEX←INDEX;
		    [XPOPERATE/2]
			BEGIN OPRINT;OPRINT;OPRINT;OPRINT;OPRINT;DPRINT;DPRINT; END;
		    [XPSPROUT/2]
			BEGIN INTEGER I,N;
			    DPRINT;
			    N←RR[INDEX];
			    FOR I←1 STEP 1 UNTIL N DO
				BEGIN NLPRINT; RDPRINT(2-2*I);OPRINT; END;
			    NLPRINT; OPRINT;
			END;
		    ELSE INDEX←INDEX
		END;
		
	END;
	INDEX←SNUM-1;
	WHILE INDEX<INDEXF DO NPCODE;
END;

PROCEDURE COMCODE(RPTR(EXPR$)EE;INTEGER SNUM);
BEGIN	PPRIN(EXPR$:BODY[EE],SNUM,EXPR$:#BODY[EE],NULL);
	EMIT(CRLF&CVS(EXPR$:#BODY[EE]+1)&":"&CRLF);
END;

INTERNAL PROCEDURE PPCODE(RPTR(EXPR$)EE;INTEGER SNUM(1));
BEGIN	TOTTY←TRUE;
	COMCODE(EE,SNUM);
	TOTTY←FALSE;
END;

INTERNAL PROCEDURE PWCODE(RPTR(EXPR$)EE;INTEGER SNUM(1));
BEGIN	TOTTY←FALSE;
	OCHAN←ORAFILE("PPCODE.FOO",FF&$CLNSAVE&CRLF);
	COMCODE(EE,SNUM);
	CRAFILE(OCHAN);
	TOTTY←TRUE;
END;

PROCEDURE PPPCODE;ppcode(null_record);
END;